home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0020_Hi Resolution Timer.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  3KB  |  105 lines
  1. UNIT Timer;
  2.  
  3. { TIMER - Fine resolution timer functions              }
  4.  
  5. INTERFACE
  6. USES Crt,Dos;
  7. CONST
  8.    TixSec  = 18.20648193;
  9.    TixMin  = TixSec * 60.0;
  10.    TixHour = TixMin * 60.0;
  11.    TixDay  = TixHour * 24.0;
  12. TYPE
  13.    DiffType = String[16];
  14. VAR
  15.    tGet       : Longint ABSOLUTE $0040:$006C;
  16. FUNCTION tStart: Longint;
  17. FUNCTION tDiff(StartTime,EndTime: Longint) : Real;
  18. FUNCTION tFormat(T1,T2:Longint): DiffType;
  19. PROCEDURE GetTime(H,M,S,S100:Word);
  20.  
  21. IMPLEMENTATION
  22.  
  23. VAR
  24.    TimeDiff   : DiffType;
  25.  
  26. { tStart - wait for a new tick, and return the
  27.   tick number to the caller.  The wait allows
  28.   us to be sure the user gets a start at the
  29.   beginning of the second.                             }
  30.  
  31. FUNCTION tStart: Longint;
  32. VAR
  33.    StartTime : Longint;
  34. BEGIN
  35.           StartTime := tGet;
  36.    WHILE StartTime = tGet DO;
  37.           tStart := tGet
  38. END;
  39.  
  40. { tDiff - compute the difference between two
  41.   timepoints (in seconds). }
  42.  
  43. FUNCTION tDiff(StartTime,EndTime: Longint) : Real;
  44. BEGIN
  45.    tDiff := (EndTime-StartTime)/TixSec;
  46. END;
  47.  
  48. PROCEDURE GetTime(H,M,S,S100:Word);
  49. VAR
  50.    Regs : Registers;
  51. BEGIN
  52.    Regs.AH := $2C;
  53.    MsDos(Regs);
  54.    H := Regs.CH;
  55.    M := Regs.CL;
  56.    S := Regs.DH;
  57.    S100 := Regs.DL
  58. END;
  59.  
  60. { tFormat - given two times, return a pointer
  61.   to a (static) string that is the difference
  62.   in the times, formatted HH:MM:SS }
  63.  
  64. FUNCTION tFormat(T1,T2:Longint): DiffType;
  65.  
  66. FUNCTION rMod(P1,P2: Real): Real;
  67. BEGIN
  68.    rMod := Frac(P1/P2) * P2
  69. END;
  70.  
  71. VAR
  72.         Temp : Real;
  73.    tStr : String;
  74.    TempStr : String[2];
  75.    TimeValue : ARRAY [1..4] OF Longint;
  76.    I : Integer;
  77. BEGIN
  78.    Temp := t2-t1;           { Time diff. }
  79.    {Adj midnight crossover}
  80.    IF Temp < 0 THEN
  81.           Temp := Temp + TixDay;
  82.           TimeValue[1] := Trunc(Temp/TixHour);  {hours}
  83.           Temp := rMod(Temp,TixHour);
  84.    TimeValue[2] := Trunc(Temp/TixMin); {minutes}
  85.    Temp := rMod(Temp,TixMin);
  86.    TimeValue[3] := Trunc(Temp/TixSec); {seconds}
  87.    Temp := rMod(Temp,TixSec);     {milliseconds}
  88.    TimeValue[4] := Trunc(Temp*100.0/TixSec+0.5);
  89.    STR(TimeValue[1]:2,tStr);
  90.    IF tStr[1] = ' ' THEN tStr[1] := '0';
  91.    FOR I := 2 TO 3 DO
  92.       BEGIN
  93.          STR(TimeValue[I]:2,TempStr);
  94.          IF TempStr[1]=' ' THEN
  95.                             TempStr[1]:='0';
  96.          tStr := tStr + ':'+ TempStr
  97.       END;
  98.    STR(TimeValue[4]:2,TempStr);
  99.    IF TempStr[1]=' ' THEN TempStr[1]:='0';
  100.    tStr := tStr + '.' + TempStr;
  101.    tFormat := tStr
  102. END;
  103.  
  104. END.
  105.